unit osbind;

interface

uses classes,sysutils,vm,compiler
{$IFDEF DELPHI}
,windows
{$ELSE}
,unix,baseunix
{$ENDIF}

;
procedure osbindwords(vm:TKsanaForthVM);
procedure forth_LoadLib(vm:TKsanaForthVM);
const
  osapi_prefix = '';
implementation
//( -name- handle)
procedure forth_LoadLib(vm:TKsanaForthVM);
var
  s:string;
  i,hmodule:integer;
begin
  s:=vm.zword;
{$IFDEF DELPHI}
  hmodule:=loadlibrary(pchar(s));
{$ELSE}
  //load share object
{$ENDIF}
  if hmodule>0 then begin
    i:=pos('.',s);
    s:=copy(s,1,i-1);
    vm.createword(s,vm.cp,false,true,false); /// compileonly codeword
    vm.compilecode(integer(@forth_docon));
    vm.compilecell(integer(hmodule));
  end else begin
    vm.error('cannot load library '+s);
  end;

end;
// osapi take consume n items on stack
// and always leave a param on tos
procedure forth_doosapi_i386(vm:TKsanaForthVM);
var
  i,p,r,addr,paramcount:integer;
begin
  addr:=pinteger(vm.ip)^;
  inc(vm.ip,CELLSIZE);

  paramcount:=pinteger(vm.ip)^;
  inc(vm.ip,CELLSIZE);

  //move forth stack to os stack
  for i:=0 to paramcount-1 do begin
    p:=vm.pop;
    asm  push p end;
  end;

  asm
    call addr  // make a call
    mov r,eax  // get the return value
  end;
  vm.push(r);
end;
//create a word with the prefix '~'+name os api
//( library nparam  -name- )
procedure forth_osapi(vm:TKsanaForthVM);
var
  s:string;
  hmodule,pcount:integer;
  addr:pointer;
begin
  s:=vm.zword;
  pcount:=vm.pop;
  hmodule:=vm.pop;
{$IFDEF DELPHI}
  addr:=getprocaddress(hmodule,pchar(s));
{$ENDIF}
  if addr=nil then begin
    vm.error('cannot load function '+s);
  end else begin
    vm.makehead(pchar(osapi_prefix+s),length(s)+length(osapi_prefix));
    vm.compilecode(integer(@forth_doosapi_i386));//or COMPILEONLY_MASK);
    vm.compilecell(integer(addr));      // actual address of the API
    vm.compilecell(integer(pcount));    // number of parameters
    forth_semicolon(vm);
  end;

end;
procedure osbindwords(vm:TKsanaForthVM);
begin
  vm.addcodeword('loadlib',integer(@forth_loadlib)); //// ( <library> -- library )
  vm.addcodeword('osapi:',integer(@forth_osapi)); //// ( library n <function> -- )
  vm.addcodeword('(osapi)',integer(@forth_doosapi_i386),false,true); //// ( pn ... p2 p1 -- f ) depend the os function
end;

end.
